home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / perl / perl5a1.lha / perl5alpha1 / doop.c2 < prev    next >
Text File  |  1993-01-18  |  13KB  |  572 lines
  1. /* $RCSfile: doarg.c,v $$Revision: 4.1 $$Date: 92/08/07 17:19:37 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    doarg.c,v $
  9.  * Revision 4.1  92/08/07  17:19:37  lwall
  10.  * Stage 6 Snapshot
  11.  * 
  12.  * Revision 4.0.1.7  92/06/11  21:07:11  lwall
  13.  * patch34: join with null list attempted negative allocation
  14.  * patch34: sprintf("%6.4s", "abcdefg") didn't print "abcd  "
  15.  * 
  16.  * Revision 4.0.1.6  92/06/08  12:34:30  lwall
  17.  * patch20: removed implicit int declarations on funcions
  18.  * patch20: pattern modifiers i and o didn't interact right
  19.  * patch20: join() now pre-extends target string to avoid excessive copying
  20.  * patch20: fixed confusion between a *var's real name and its effective name
  21.  * patch20: subroutines didn't localize $`, $&, $', $1 et al correctly
  22.  * patch20: usersub routines didn't reclaim temp values soon enough
  23.  * patch20: ($<,$>) = ... didn't work on some architectures
  24.  * patch20: added Atari ST portability
  25.  * 
  26.  * Revision 4.0.1.5  91/11/11  16:31:58  lwall
  27.  * patch19: added little-endian pack/unpack options
  28.  * 
  29.  * Revision 4.0.1.4  91/11/05  16:35:06  lwall
  30.  * patch11: /$foo/o optimizer could access deallocated data
  31.  * patch11: minimum match length calculation in regexp is now cumulative
  32.  * patch11: added some support for 64-bit integers
  33.  * patch11: prepared for ctype implementations that don't define isascii()
  34.  * patch11: sprintf() now supports any length of s field
  35.  * patch11: indirect subroutine calls through magic vars (e.g. &$1) didn't work
  36.  * patch11: defined(&$foo) and undef(&$foo) didn't work
  37.  * 
  38.  * Revision 4.0.1.3  91/06/10  01:18:41  lwall
  39.  * patch10: pack(hh,1) dumped core
  40.  * 
  41.  * Revision 4.0.1.2  91/06/07  10:42:17  lwall
  42.  * patch4: new copyright notice
  43.  * patch4: // wouldn't use previous pattern if it started with a null character
  44.  * patch4: //o and s///o now optimize themselves fully at runtime
  45.  * patch4: added global modifier for pattern matches
  46.  * patch4: undef @array disabled "@array" interpolation
  47.  * patch4: chop("") was returning "\0" rather than ""
  48.  * patch4: vector logical operations &, | and ^ sometimes returned null string
  49.  * patch4: syscall couldn't pass numbers with most significant bit set on sparcs
  50.  * 
  51.  * Revision 4.0.1.1  91/04/11  17:40:14  lwall
  52.  * patch1: fixed undefined environ problem
  53.  * patch1: fixed debugger coredump on subroutines
  54.  * 
  55.  * Revision 4.0  91/03/20  01:06:42  lwall
  56.  * 4.0 baseline.
  57.  * 
  58.  */
  59.  
  60. #include "EXTERN.h"
  61. #include "perl.h"
  62.  
  63. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  64. #include <signal.h>
  65. #endif
  66.  
  67. #ifdef BUGGY_MSC
  68.  #pragma function(memcmp)
  69. #endif /* BUGGY_MSC */
  70.  
  71. static void doencodes();
  72.  
  73. #ifdef BUGGY_MSC
  74.  #pragma intrinsic(memcmp)
  75. #endif /* BUGGY_MSC */
  76.  
  77. int
  78. do_trans(sv,arg)
  79. SV *sv;
  80. OP *arg;
  81. {
  82.     register short *tbl;
  83.     register char *s;
  84.     register int matches = 0;
  85.     register int ch;
  86.     register char *send;
  87.     register char *d;
  88.     register int squash = op->op_private & OPpTRANS_SQUASH;
  89.  
  90.     tbl = (short*) cPVOP->op_pv;
  91.     s = SvPV(sv);
  92.     send = s + sv->sv_cur;
  93.     if (!tbl || !s)
  94.     fatal("panic: do_trans");
  95. #ifdef DEBUGGING
  96.     if (debug & 8) {
  97.     deb("2.TBL\n");
  98.     }
  99. #endif
  100.     if (!op->op_private) {
  101.     while (s < send) {
  102.         if ((ch = tbl[*s & 0377]) >= 0) {
  103.         matches++;
  104.         *s = ch;
  105.         }
  106.         s++;
  107.     }
  108.     }
  109.     else {
  110.     d = s;
  111.     while (s < send) {
  112.         if ((ch = tbl[*s & 0377]) >= 0) {
  113.         *d = ch;
  114.         if (matches++ && squash) {
  115.             if (d[-1] == *d)
  116.             matches--;
  117.             else
  118.             d++;
  119.         }
  120.         else
  121.             d++;
  122.         }
  123.         else if (ch == -1)        /* -1 is unmapped character */
  124.         *d++ = *s;        /* -2 is delete character */
  125.         s++;
  126.     }
  127.     matches += send - d;    /* account for disappeared chars */
  128.     *d = '\0';
  129.     sv->sv_cur = d - sv->sv_ptr;
  130.     }
  131.     SvSETMAGIC(sv);
  132.     return matches;
  133. }
  134.  
  135. void
  136. do_join(sv,del,mark,sp)
  137. register SV *sv;
  138. SV *del;
  139. register SV **mark;
  140. register SV **sp;
  141. {
  142.     SV **oldmark = mark;
  143.     register int items = sp - mark;
  144.     register char *delim = SvPV(del);
  145.     register STRLEN len;
  146.     int delimlen = del->sv_cur;
  147.  
  148.     mark++;
  149.     len = (items > 0 ? (delimlen * (items - 1) ) : 0);
  150.     if (sv->sv_len < len + items) {    /* current length is way too short */
  151.     while (items-- > 0) {
  152.         if (*mark)
  153.         len += (*mark)->sv_cur;
  154.         mark++;
  155.     }
  156.     SvGROW(sv, len + 1);        /* so try to pre-extend */
  157.  
  158.     mark = oldmark;
  159.     items = sp - mark;;
  160.     ++mark;
  161.     }
  162.  
  163.     if (items-- > 0)
  164.     sv_setsv(sv, *mark++);
  165.     else
  166.     sv_setpv(sv,"");
  167.     len = delimlen;
  168.     if (len) {
  169.     for (; items > 0; items--,mark++) {
  170.         sv_catpvn(sv,delim,len);
  171.         sv_catsv(sv,*mark);
  172.     }
  173.     }
  174.     else {
  175.     for (; items > 0; items--,mark++)
  176.         sv_catsv(sv,*mark);
  177.     }
  178.     SvSETMAGIC(sv);
  179. }
  180.  
  181. void
  182. do_sprintf(sv,numargs,firstarg)
  183. register SV *sv;
  184. int numargs;
  185. SV **firstarg;
  186. {
  187.     register char *s;
  188.     register char *t;
  189.     register char *f;
  190.     register int argix = 0;
  191.     register SV **sarg = firstarg;
  192.     bool dolong;
  193. #ifdef QUAD
  194.     bool doquad;
  195. #endif /* QUAD */
  196.     char ch;
  197.     register char *send;
  198.     register SV *arg;
  199.     char *xs;
  200.     int xlen;
  201.     int pre;
  202.     int post;
  203.     double value;
  204.  
  205.     sv_setpv(sv,"");
  206.     len--;            /* don't count pattern string */
  207.     t = s = SvPV(*sarg);
  208.     send = s + (*sarg)->sv_cur;
  209.     sarg++;
  210.     for ( ; ; argix++) {
  211.  
  212.     /*SUPPRESS 530*/
  213.     for ( ; t < send && *t != '%'; t++) ;
  214.     if (t >= send)
  215.         break;        /* end of run_format string, ignore extra args */
  216.     f = t;
  217.     if (t[2] == '$' && isDIGIT(t[1])) {
  218.         ch = *(++t);
  219.         *t = '\0';
  220.         (void)sprintf(xs,t);
  221.         sv_catpvn(sv, xs, xlen);
  222.         argix = atoi(t+1);
  223.         sarg = firstarg + argix;
  224.         t[2] = '%';
  225.         f += 2;
  226.  
  227.     }
  228.     /*SUPPRESS 560*/
  229.     if (argix > numargs || !(arg = *sarg++))
  230.         arg = &sv_no;
  231.  
  232.     *buf = '\0';
  233.     xs = buf;
  234. #ifdef QUAD
  235.     doquad =
  236. #endif /* QUAD */
  237.     dolong = FALSE;
  238.     pre = post = 0;
  239.     for (t++; t < send; t++) {
  240.         switch (*t) {
  241.         default:
  242.         ch = *(++t);
  243.         *t = '\0';
  244.         (void)sprintf(xs,f);
  245.         argix--, sarg--;
  246.         xlen = strlen(xs);
  247.         break;
  248.         case '0': case '1': case '2': case '3': case '4':
  249.         case '5': case '6': case '7': case '8': case '9': 
  250.         case '.': case '#': case '-': case '+': case ' ':
  251.         continue;
  252.         case 'l':
  253. #ifdef QUAD
  254.         if (dolong) {
  255.             dolong = FALSE;
  256.             doquad = TRUE;
  257.         } else
  258. #endif
  259.         dolong = TRUE;
  260.         continue;
  261.         case 'c':
  262.         ch = *(++t);
  263.         *t = '\0';
  264.         xlen = (int)SvNV(arg);
  265.         if (strEQ(f,"%c")) { /* some printfs fail on null chars */
  266.             *xs = xlen;
  267.             xs[1] = '\0';
  268.             xlen = 1;
  269.         }
  270.         else {
  271.             (void)sprintf(xs,f,xlen);
  272.             xlen = strlen(xs);
  273.         }
  274.         break;
  275.         case 'D':
  276.         dolong = TRUE;
  277.         /* FALL THROUGH */
  278.         case 'd':
  279.         ch = *(++t);
  280.         *t = '\0';
  281. #ifdef QUAD
  282.         if (doquad)
  283.             (void)sprintf(buf,s,(quad)SvNV(arg));
  284.         else
  285. #endif
  286.         if (dolong)
  287.             (void)sprintf(xs,f,(long)SvNV(arg));
  288.         else
  289.             (void)sprintf(xs,f,(int)SvNV(arg));
  290.         xlen = strlen(xs);
  291.         break;
  292.         case 'X': case 'O':
  293.         dolong = TRUE;
  294.         /* FALL THROUGH */
  295.         case 'x': case 'o': case 'u':
  296.         ch = *(++t);
  297.         *t = '\0';
  298.         value = SvNV(arg);
  299. #ifdef QUAD
  300.         if (doquad)
  301.             (void)sprintf(buf,s,(unsigned quad)value);
  302.         else
  303. #endif
  304.         if (dolong)
  305.             (void)sprintf(xs,f,U_L(value));
  306.         else
  307.             (void)sprintf(xs,f,U_I(value));
  308.         xlen = strlen(xs);
  309.         break;
  310.         case 'E': case 'e': case 'f': case 'G': case 'g':
  311.         ch = *(++t);
  312.         *t = '\0';
  313.         (void)sprintf(xs,f,SvNV(arg));
  314.         xlen = strlen(xs);
  315.         break;
  316.         case 's':
  317.         ch = *(++t);
  318.         *t = '\0';
  319.         xs = SvPV(arg);
  320.         xlen = arg->sv_cur;
  321.         if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B' && xs[3] == '\0'
  322.           && xlen == sizeof(GP)) {
  323.             SV *tmpstr = NEWSV(24,0);
  324.  
  325.             gv_efullname(tmpstr, ((GV*)arg)); /* a gv value! */
  326.             sprintf(tokenbuf,"*%s",tmpstr->sv_ptr);
  327.                     /* reformat to non-binary */
  328.             xs = tokenbuf;
  329.             xlen = strlen(tokenbuf);
  330.             sv_free(tmpstr);
  331.         }
  332.         if (strEQ(f,"%s")) {    /* some printfs fail on >128 chars */
  333.             break;        /* so handle simple cases */
  334.         }
  335.         else if (f[1] == '-') {
  336.             char *mp = index(f, '.');
  337.             int min = atoi(f+2);
  338.  
  339.             if (mp) {
  340.             int max = atoi(mp+1);
  341.  
  342.             if (xlen > max)
  343.                 xlen = max;
  344.             }
  345.             if (xlen < min)
  346.             post = min - xlen;
  347.             break;
  348.         }
  349.         else if (isDIGIT(f[1])) {
  350.             char *mp = index(f, '.');
  351.             int min = atoi(f+1);
  352.  
  353.             if (mp) {
  354.             int max = atoi(mp+1);
  355.  
  356.             if (xlen > max)
  357.                 xlen = max;
  358.             }
  359.             if (xlen < min)
  360.             pre = min - xlen;
  361.             break;
  362.         }
  363.         strcpy(tokenbuf+64,f);    /* sprintf($s,...$s...) */
  364.         *t = ch;
  365.         (void)sprintf(buf,tokenbuf+64,xs);
  366.         xs = buf;
  367.         xlen = strlen(xs);
  368.         break;
  369.         }
  370.         /* end of switch, copy results */
  371.         *t = ch;
  372.         SvGROW(sv, sv->sv_cur + (f - s) + xlen + 1 + pre + post);
  373.         sv_catpvn(sv, s, f - s);
  374.         if (pre) {
  375.         repeatcpy(sv->sv_ptr + sv->sv_cur, " ", 1, pre);
  376.         sv->sv_cur += pre;
  377.         }
  378.         sv_catpvn(sv, xs, xlen);
  379.         if (post) {
  380.         repeatcpy(sv->sv_ptr + sv->sv_cur, " ", 1, post);
  381.         sv->sv_cur += post;
  382.         }
  383.         s = t;
  384.         break;        /* break from for loop */
  385.     }
  386.     }
  387.     sv_catpvn(sv, s, t - s);
  388.     SvSETMAGIC(sv);
  389. }
  390.  
  391. void
  392. do_vecset(mstr,sv)
  393. SV *mstr;
  394. SV *sv;
  395. {
  396.     struct lstring *lstr = (struct lstring*)sv;
  397.     register int offset;
  398.     register int size;
  399.     register unsigned char *s = (unsigned char*)mstr->sv_ptr;
  400.     register unsigned long lval = U_L(SvNV(sv));
  401.     int mask;
  402.  
  403.     mstr->sv_rare = 0;
  404.     sv->sv_magic = Nullsv;
  405.     offset = lstr->lstr_offset;
  406.     size = lstr->lstr_len;
  407.     if (size < 8) {
  408.     mask = (1 << size) - 1;
  409.     size = offset & 7;
  410.     lval &= mask;
  411.     offset >>= 3;
  412.     s[offset] &= ~(mask << size);
  413.     s[offset] |= lval << size;
  414.     }
  415.     else {
  416.     if (size == 8)
  417.         s[offset] = lval & 255;
  418.     else if (size == 16) {
  419.         s[offset] = (lval >> 8) & 255;
  420.         s[offset+1] = lval & 255;
  421.     }
  422.     else if (size == 32) {
  423.         s[offset] = (lval >> 24) & 255;
  424.         s[offset+1] = (lval >> 16) & 255;
  425.         s[offset+2] = (lval >> 8) & 255;
  426.         s[offset+3] = lval & 255;
  427.     }
  428.     }
  429. }
  430.  
  431. void
  432. do_chop(astr,sv)
  433. register SV *astr;
  434. register SV *sv;
  435. {
  436.     register char *tmps;
  437.     register int i;
  438.     AV *ary;
  439.     HV *hash;
  440.     HE *entry;
  441.  
  442.     if (!sv)
  443.     return;
  444.     if (sv->sv_state == SVs_AV) {
  445.     ary = (AV*)sv;
  446.     for (i = 0; i <= ary->av_fill; i++)
  447.         do_chop(astr,ary->av_array[i]);
  448.     return;
  449.     }
  450.     if (sv->sv_state == SVs_HV) {
  451.     hash = (HV*)sv;
  452.     (void)hv_iterinit(hash);
  453.     /*SUPPRESS 560*/
  454.     while (entry = hv_iternext(hash))
  455.         do_chop(astr,hv_iterval(hash,entry));
  456.     return;
  457.     }
  458.     tmps = SvPV(sv);
  459.     if (tmps && sv->sv_cur) {
  460.     tmps += sv->sv_cur - 1;
  461.     sv_setpvn(astr,tmps,1);    /* remember last char */
  462.     *tmps = '\0';                /* wipe it out */
  463.     sv->sv_cur = tmps - sv->sv_ptr;
  464.     sv->sv_nok = 0;
  465.     SvSETMAGIC(sv);
  466.     }
  467.     else
  468.     sv_setpvn(astr,"",0);
  469. }
  470.  
  471. void
  472. do_vop(optype,sv,left,right)
  473. int optype;
  474. SV *sv;
  475. SV *left;
  476. SV *right;
  477. {
  478. #ifdef LIBERAL
  479.     register long *dl;
  480.     register long *ll;
  481.     register long *rl;
  482. #endif
  483.     register char *dc;
  484.     register char *lc = SvPV(left);
  485.     register char *rc = SvPV(right);
  486.     register int len;
  487.  
  488.     len = left->sv_cur;
  489.     if (len > right->sv_cur)
  490.     len = right->sv_cur;
  491.     if (sv->sv_cur > len)
  492.     sv->sv_cur = len;
  493.     else if (sv->sv_cur < len) {
  494.     SvGROW(sv,len);
  495.     (void)memzero(sv->sv_ptr + sv->sv_cur, len - sv->sv_cur);
  496.     sv->sv_cur = len;
  497.     }
  498.     sv->sv_pok = 1;
  499.     sv->sv_nok = 0;
  500.     dc = sv->sv_ptr;
  501.     if (!dc) {
  502.     sv_setpvn(sv,"",0);
  503.     dc = sv->sv_ptr;
  504.     }
  505. #ifdef LIBERAL
  506.     if (len >= sizeof(long)*4 &&
  507.     !((long)dc % sizeof(long)) &&
  508.     !((long)lc % sizeof(long)) &&
  509.     !((long)rc % sizeof(long)))    /* It's almost always aligned... */
  510.     {
  511.     int remainder = len % (sizeof(long)*4);
  512.     len /= (sizeof(long)*4);
  513.  
  514.     dl = (long*)dc;
  515.     ll = (long*)lc;
  516.     rl = (long*)rc;
  517.  
  518.     switch (optype) {
  519.     case OP_BIT_AND:
  520.         while (len--) {
  521.         *dl++ = *ll++ & *rl++;
  522.         *dl++ = *ll++ & *rl++;
  523.         *dl++ = *ll++ & *rl++;
  524.         *dl++ = *ll++ & *rl++;
  525.         }
  526.         break;
  527.     case OP_XOR:
  528.         while (len--) {
  529.         *dl++ = *ll++ ^ *rl++;
  530.         *dl++ = *ll++ ^ *rl++;
  531.         *dl++ = *ll++ ^ *rl++;
  532.         *dl++ = *ll++ ^ *rl++;
  533.         }
  534.         break;
  535.     case OP_BIT_OR:
  536.         while (len--) {
  537.         *dl++ = *ll++ | *rl++;
  538.         *dl++ = *ll++ | *rl++;
  539.         *dl++ = *ll++ | *rl++;
  540.         *dl++ = *ll++ | *rl++;
  541.         }
  542.     }
  543.  
  544.     dc = (char*)dl;
  545.     lc = (char*)ll;
  546.     rc = (char*)rl;
  547.  
  548.     len = remainder;
  549.     }
  550. #endif
  551.     switch (optype) {
  552.     case OP_BIT_AND:
  553.     while (len--)
  554.         *dc++ = *lc++ & *rc++;
  555.     break;
  556.     case OP_XOR:
  557.     while (len--)
  558.         *dc++ = *lc++ ^ *rc++;
  559.     goto mop_up;
  560.     case OP_BIT_OR:
  561.     while (len--)
  562.         *dc++ = *lc++ | *rc++;
  563.       mop_up:
  564.     len = sv->sv_cur;
  565.     if (right->sv_cur > len)
  566.         sv_catpvn(sv,right->sv_ptr+len,right->sv_cur - len);
  567.     else if (left->sv_cur > len)
  568.         sv_catpvn(sv,left->sv_ptr+len,left->sv_cur - len);
  569.     break;
  570.     }
  571. }
  572.